Os Jogos Olímpicos representam um dos maiores eventos esportivos do mundo, reunindo países de diferentes continentes. Neste trabalho, buscaremos explorar duas frentes complementares. Primeiro, analisaremos aspectos gerais das Olimpíadas, apresentando um panorama histórico e descritivo dos Jogos Olímpicos Modernos. Em seguida, aprofundaremos a análise na pergunta: “Qual é o impacto de sediar os Jogos Olímpicos sobre o desempenho de um país?”. Para responder a questão, utilizaremos duas métricas para comparar o desempenho médio das nações quando atuam como anfitriãs e o desempenho médio quando competem como visitantes. A partir dessas medidas, buscaremos identificar a existência de um “efeito sede” e comparar o desempenho do Brasil com a performance geral.
Os dados utilizados neste trabalho foram obtidos a partir do repositório Historical Data from the Olympics, disponível na plataforma Base dos Dados. O conjunto é uma tentativa de criar uma base de dados atualizada com informações sobre os Jogos Olímpicos. A partir dessas bases, realizamos etapas de limpeza, padronização e agregação das informações, construindo métricas próprias para avaliar o desempenho médio dos países como sede e como não sede. Os dados contidos nessas bases de dados abrange todos os jogos que ocorreram entre a edição de 1896 em Atenas e a edição de 2022 em Beijing, portanto os resultados dos jogos olímpicos de 2024 em Paris e os jogos de 2026 em Milão/Cortina não serão levados em consideração nesta análise.
As análises foram conduzidas utilizando a linguagem R e todo o código utilizado para limpeza, construção das métricas e geração das visualizações está disponível no repositório do projeto no GitHub. Além disso, as seguintes bibliotecas foram utilizadas:
# install.packages(c("tidyverse", "ggrepel", "countrycode", "gt", "sf", "rnaturalearth", "rnaturalearthdata", "tidygeocoder", "patchwork"))
# remotes::install_github("ropensci/rnaturalearthhires")
library(sf)
library(gt)
library(ggrepel)
library(patchwork)
library(tidyverse)
library(countrycode)
library(tidygeocoder)
library(rnaturalearth)
library(rnaturalearthdata)
library(rnaturalearthhires)
As seguintes bases serão utilizadas ao longo da análise:
game <- read_csv("../data/raw/game.csv.gz")
country <- read.csv("../data/raw/country.csv.gz")
athlete_bio <- read.csv("../data/raw/athlete_bio.csv.gz")
game_medal_tally <- read_csv("../data/raw/game_medal_tally.csv.gz")
athlete_event_result <- read_csv("../data/raw/athlete_event_result.csv.gz")
Antes da construção das métricas e visualizações, foi realizada uma etapa de tratamento e padronização das bases, pois os dados são provenientes de diferentes tabelas. Inicialmente, removemos os Jogos Intercalados de 1906, uma vez que suas premiações não são oficialmente reconhecidas pelo Comitê Olímpico Internacional. Também desconsideramos edições que não foram realizadas e padronizamos a variável edition para distinguir apenas entre Jogos de Verão e Jogos de Inverno. Um ponto específico tratado foi o caso do hipismo em 1956. Embora as provas equestres tenham ocorrido em Estocolmo (Suécia), devido às restrições sanitárias da Austrália, elas foram incorporadas à edição de Melbourne para manter a coerência histórica da sede.
Na base de atletas, selecionamos apenas as variáveis relevantes para a análise e removemos registros duplicados. Consideramos que, em uma mesma edição, um atleta pode participar apenas uma vez de uma determinada prova representando um único país. Quando havia múltiplos registros para a mesma combinação de atleta, edição e evento, mantivemos apenas um, priorizando, quando aplicável, o registro com premiação. Além disso, identificamos seis atletas com informações ausentes de nome e sexo. Esses dados foram completados manualmente a partir do identificador do atleta, utilizando como referência a plataforma Olympedia.
game <- game |>
# Retira as sedes de jogos que não ocorreram ou não são considerados
filter(
edition != "1906 Intercalated",
edition != "1956 Equestrian",
is.na(is_held),
year <= 2022
) |>
mutate(
edition = case_when(
str_detect(edition, "Summer") ~ "Olimpíadas de Verão",
str_detect(edition, "Winter") ~ "Olimpíadas de Inverno"
)
) |>
select(edition_id, edition, country_flag_url, city, host_country = country_noc)
country <- country |>
# Retira sigla "ROC" duplicada
filter(name != "ROC")
athlete_bio <- athlete_bio |>
select(athlete_id, sex, name) |>
mutate(athlete_id = as.numeric(athlete_id))
game_medal_tally <- game_medal_tally |>
# Atrela o hipismo à sede na Austrália
mutate(edition_id = replace(edition_id, edition_id == 48, 14)) |>
# Retira os jogos intercalados
filter(year != 1906) |>
mutate(
edition = case_when(
str_detect(edition, "Summer") ~ "Olimpíadas de Verão",
str_detect(edition, "Equestrian") ~ "Olimpíadas de Verão",
str_detect(edition, "Winter") ~ "Olimpíadas de Inverno"
)
)
athlete_event_result <- athlete_event_result |>
mutate(
year = as.integer(str_extract(edition, "^\\d{4}")),
# Atrela o hipismo à sede na Austrália
edition_id = replace(edition_id, edition_id == 48, 14),
edition = case_when(
str_detect(edition, "Summer") ~ "Olimpíadas de Verão",
str_detect(edition, "Equestrian") ~ "Olimpíadas de Verão",
str_detect(edition, "Winter") ~ "Olimpíadas de Inverno",
TRUE ~ "other"
),
medal = na_if(medal, "")
) |>
# Retira os jogos intercalados
filter(year != 1906) |>
select(
year,
edition_id,
edition,
country_noc,
athlete_id,
sport,
event,
medal
) |>
# Remove duplicatas
arrange(athlete_id, edition_id, sport, event, medal) |>
group_by(athlete_id, edition_id, sport, event) |>
slice(1) |>
ungroup()
athlete_bio_result <- athlete_event_result |>
left_join(athlete_bio, by = "athlete_id") |>
# Preenche dados faltantes
mutate(
name = case_when(
athlete_id == 69534 ~ "John Thornton",
athlete_id == 36110 ~ "Frank Courtney",
athlete_id == 2302137 ~ "Peter Hunter Gaskell",
athlete_id == 902283 ~ "Kay Todd, Jr.",
athlete_id == 920957 ~ "Hoka Iwabuchi",
athlete_id == 37833 ~ "Hans Joachim Hannemann",
TRUE ~ name
),
sex = case_when(
athlete_id %in% c(69534,36110,2302137,902283,920957,37833) ~ "Male",
TRUE ~ sex)
)
Para estas análises vamos necessitar de mais algumas etapas de tratamentos de dados, utilizando as bases tratadas anteriormente.
# União das Bases de Dados
dados_participacoes <- athlete_bio_result %>%
# Tradução de Variáveis
transmute(ano = year,
edicao_id = edition_id,
estacao = case_when(str_detect(edition, "Verão") ~ "Verão",
str_detect(edition, "Inverno") ~ "Inverno"),
atleta_id = athlete_id,
nome = str_trim(name),
pais_sg = country_noc,
sexo = case_when(sex == "Male" ~ "Homem",
sex == "Female" ~"Mulher"),
esporte = sport,
modalidade = event,
medalha = factor(medal,
level = c("Gold", "Silver", "Bronze"),
labels = c("Ouro", "Prata", "Bronze")))
Também vamos coletar a posição espacial (latitude e longitude) de todas as cidades que já sediaram os jogos olímpicos.
# Tradução de Variáveis
siglas_convercao <- country %>%
transmute(pais_sg = noc,
pais = name)
dados_latlong <- game %>%
# Tradução de Variáveis
mutate(edicao_id = edition_id,
estacao = case_when(str_detect(edition, "Verão") ~ "Verão",
str_detect(edition, "Inverno") ~ "Inverno"),
cidade = city,
pais_sg = host_country,
bandeira_url = country_flag_url) %>%
# Inserir o Nome dos Países
geocode(city = cidade, method = 'osm', lat = latitude , long = longitude) %>%
left_join(siglas_convercao, by = "pais_sg") %>%
select(edicao_id, estacao, cidade, pais_sg, pais, bandeira_url, latitude, longitude)
Para iniciar a análise, vamos filtrar dois dataframes que vão ser muito utilizados ao longo do processo:
dados_participacoes_verao <- dados_participacoes %>%
filter(estacao == "Verão")
dados_participacoes_inverno <- dados_participacoes %>%
filter(estacao == "Inverno")
Vamos iniciar fazendo um levantamento do número de atletas nas olímpiadas ao longo do tempo e como os acontecimentos geopolíticos influênciam na participação nos jogos.
# Participações Verão
participantes_ano <- dados_participacoes_verao |>
group_by(ano) |>
distinct(atleta_id, .keep_all = TRUE) |>
summarise(contagem = n())
# Anos Importantes
pontos_relevantes <- data.frame(
x = c(1932, 1956, 1980),
y = c(2057, 3549, 5383),
l = c("Grande Depressão", "Triplo Boicote", "Guerra Fria")
)
# Plotagem
ggplot(participantes_ano, aes(x = ano, y = contagem)) +
geom_area(linewidth = 2,
color = winter_swiss_1928_palette$primary[1],
fill = winter_swiss_1928_palette$primary[1],
alpha = 0.8) +
# Anos Importantes
geom_point(data = pontos_relevantes,
aes(x = x, y = y),
color = winter_swiss_1928_palette$primary[2],
size = 3) +
geom_text(data = pontos_relevantes,
aes(x = x, y = y, label = l),
vjust = 2,
color = "#FFFFFF",
fontface = "bold",
size = 3.5) +
# Temas, Escalas e Legendas
scale_x_continuous(breaks = seq(1896, 2020, by = 31)) +
labs(title = "NÚMERO DE ATLETAS AO LONGO DO TEMPO",
subtitle = "Olimpíadas de Verão | 1896 Atenas – 2020 Tokyo",
x = "ANO",
y = "NÚMERO DE PARTICIPANTES") +
theme_olympics()
# Participações Inverno
participantes_ano <- dados_participacoes_inverno |>
group_by(ano) |>
distinct(atleta_id, .keep_all = TRUE) |>
summarise(contagem = n())
# Anos Importantes
pontos_relevantes <- data.frame(
x = c(1932, 1960, 1972, 1994),
y = c(385, 670, 1024, 1765),
l = c("Grande Depressão", "Bobsled", "Dinâmica Logistíca", "Novo Ciclo")
)
ggplot(participantes_ano, aes(x = ano, y = contagem)) +
geom_area(linewidth = 2,
color = winter_swiss_1928_palette$primary[3],
fill = winter_swiss_1928_palette$primary[3],
alpha = 0.8) +
# Anos Importantes
geom_point(data = pontos_relevantes,
aes(x = x, y = y),
color = winter_swiss_1928_palette$primary[2],
size = 3) +
geom_text(data = pontos_relevantes,
aes(x = x, y = y, label = l),
vjust = 2.2,
hjust = -0.05,
color = "#FFFFFF",
fontface = "bold",
size = 3.5) +
# Temas, Escalas e Legendas
scale_x_continuous(breaks = seq(1924, 2022, by = 14)) +
scale_y_continuous(breaks = seq(0, 3000, by = 500), limits = c(0, 3000)) +
labs(title = "NÚMERO DE ATLETAS AO LONGO DO TEMPO",
subtitle = "Olimpíadas de Inverno | 1924 Chamonix – 2022 Beijing",
x = "ANO",
y = "NÚMERO DE PARTICIPANTES") +
theme_olympics()
# Participações Verão Brasil
participantes_ano <- dados_participacoes_verao |>
filter(pais_sg == "BRA") |>
group_by(ano) |>
distinct(atleta_id, .keep_all = TRUE) |>
summarise(contagem = n())
# Plotagem
ggplot(participantes_ano, aes(x = ano, y = contagem)) +
geom_area(linewidth = 2,
color = summer_brasil_2016_palette$primary[4],
fill = summer_brasil_2016_palette$primary[3],
alpha = 0.8) +
# Temas, Escalas e Legendas
scale_x_continuous(breaks = seq(1920, 2020, by = 20)) +
labs(title = "NÚMERO DE ATLETAS BRASILEIROS AO LONGO DO TEMPO",
subtitle = "Olimpíadas de Verão | 1920 Antuérpia – 2020 Tokyo",
x = "ANO",
y = "NÚMERO DE PARTICIPANTES") +
theme_olympics()
# Participações Inverno Brasil
participantes_ano <- dados_participacoes_inverno |>
filter(pais_sg == "BRA") |>
group_by(ano) |>
distinct(atleta_id, .keep_all = TRUE) |>
summarise(contagem = n())
# Plotagem
ggplot(participantes_ano, aes(x = ano, y = contagem)) +
geom_area(linewidth = 2,
color = summer_brasil_2016_palette$primary[2],
fill = summer_brasil_2016_palette$primary[2],
alpha = 0.8) +
# Temas, Escalas e Legendas
scale_x_continuous(breaks = seq(1992, 2022, by = 6)) +
labs(title = "NÚMERO DE ATLETAS BRASILEIROS AO LONGO DO TEMPO",
subtitle = "Olimpíadas de Inverno | 1992 Albertvill – 2022 Beijing",
x = "ANO",
y = "NÚMERO DE PARTICIPANTES") +
theme_olympics()
Com base nos gráficos elaborados acima, podemos concluir que as olimpíadas de verão em especial sofrem grande impacto de aspectos geopolíticos, enquanto isso, as olimpíadas de inverno por sua vez, possuem dificuldades mais relacionadas à esfera econômica e limite de verbas.
Após isso vamos fazer uma divisão por gênero para entender o comportamento da quantidade de atletas mulheres e o seu percentual quando comparado ao número de atletas masculinos.
# Pirâmide Gênero - Verão
piramide_genero_dados <- dados_participacoes_verao |>
group_by(ano, sexo) |>
summarise(total = n_distinct(atleta_id), .groups = "drop") |>
# Considera homens como valor negativo para separar pelo eixo
mutate(
valor_grafico = ifelse(sexo == "Homem", -total, total),
ano_fct = factor(ano, levels = sort(unique(ano), decreasing = TRUE))
)
# Gráfico
ggplot(piramide_genero_dados, aes(x = ano_fct, y = valor_grafico, fill = sexo)) +
geom_col(width = 0.8) +
# Inverte os eixos para termos o gráfico de barras horizontais
coord_flip() +
scale_y_continuous(labels = abs,
breaks = seq(-7000, 7000, by = 1000),
limits = c(-7500, 7500)) +
scale_fill_manual(values = c("Homem" = winter_swiss_1928_palette$primary[3],
"Mulher" = winter_swiss_1928_palette$primary[1]),
labels = c("Homens", "Mulheres")) +
# Tema, Títulos e Legendas
labs(
title = "EVOLUÇÃO DA PARTICIPAÇÃO POR GÊNERO",
subtitle = "Olimpíadas de Verão | 1896 Atenas – 2020 Tokyo",
x = "EDIÇÃO",
y = "TOTAL DE ATLETAS",
fill = "GÊNERO"
) +
theme_olympics() +
theme(axis.text.y = element_text(size = 8),
panel.grid.major.x = element_line(color = "gray85"))
# Pirâmide Gênero - Inverno
piramide_genero_dados <- dados_participacoes_inverno |>
group_by(ano, sexo) |>
summarise(total = n_distinct(atleta_id), .groups = "drop") |>
# Considera homens como valor negativo para separar pelo eixo
mutate(
valor_grafico = ifelse(sexo == "Homem", -total, total),
ano_fct = factor(ano, levels = sort(unique(ano), decreasing = TRUE))
)
# Gráfico
ggplot(piramide_genero_dados, aes(x = ano_fct, y = valor_grafico, fill = sexo)) +
geom_col(width = 0.8) +
# Inverte os eixos para termos o gráfico de barras horizontais
coord_flip() +
scale_y_continuous(labels = abs,
breaks = seq(-1750, 1750, by = 250),
limits = c(-1750, 1750)) +
scale_fill_manual(values = c("Homem" = winter_swiss_1928_palette$primary[3],
"Mulher" = winter_swiss_1928_palette$primary[1]),
labels = c("Homens", "Mulheres")) +
# Tema, Títulos e Legendas
labs(
title = "EVOLUÇÃO DA PARTICIPAÇÃO POR GÊNERO",
subtitle = "Olimpíadas de Inverno | 1924 Chamonix – 2022 Beijing",
x = "EDIÇÃO",
y = "TOTAL DE ATLETAS",
fill = "GÊNERO"
) +
theme_olympics() +
theme(axis.text.y = element_text(size = 8),
panel.grid.major.x = element_line(color = "gray85"))
Vamos fazer um filtro para fazer a mesma análise para os atletas do Brasil.
# Pirâmide Gênero Brasil - Verão
piramide_genero_dados <- dados_participacoes_verao |>
filter(pais_sg == "BRA") |>
group_by(ano, sexo) |>
summarise(total = n_distinct(atleta_id), .groups = "drop") |>
# Considera homens como valor negativo para separar pelo eixo
mutate(
valor_grafico = ifelse(sexo == "Homem", -total, total),
ano_fct = factor(ano, levels = sort(unique(ano), decreasing = TRUE)))
# Gráfico
ggplot(piramide_genero_dados, aes(x = ano_fct, y = valor_grafico, fill = sexo)) +
geom_col(width = 0.8) +
# Inverte os eixos para termos o gráfico de barras horizontais
coord_flip() +
scale_y_continuous(labels = abs,
breaks = seq(-300, 300, by = 50),
limits = c(-300, 300)) +
scale_fill_manual(values = c("Homem" = summer_brasil_2016_palette$primary[2],
"Mulher" = summer_brasil_2016_palette$primary[3]),
labels = c("Homens", "Mulheres")) +
# Tema, Títulos e Legendas
labs(
title = "EVOLUÇÃO DA PARTICIPAÇÃO POR GÊNERO DO BRASIL",
subtitle = "Olimpíadas de Verão | 1920 Antuérpia – 2020 Tokyo",
x = "EDIÇÃO",
y = "TOTAL DE ATLETAS",
fill = "GÊNERO"
) +
theme_olympics() +
theme(axis.text.y = element_text(size = 8),
panel.grid.major.x = element_line(color = "gray85"))
# Pirâmide Gênero Brasil - Inverno
piramide_genero_dados <- dados_participacoes_inverno |>
filter(pais_sg == "BRA") |>
group_by(ano, sexo) |>
summarise(total = n_distinct(atleta_id), .groups = "drop") |>
# Considera homens como valor negativo para separar pelo eixo
mutate(
valor_grafico = ifelse(sexo == "Homem", -total, total),
ano_fct = factor(ano, levels = sort(unique(ano), decreasing = TRUE)))
# Gráfico
ggplot(piramide_genero_dados, aes(x = ano_fct, y = valor_grafico, fill = sexo)) +
geom_col(width = 0.8) +
# Inverte os eixos para termos o gráfico de barras horizontais
coord_flip() +
scale_y_continuous(labels = abs,
breaks = seq(-10, 10, by = 1),
limits = c(-10, 10)) +
scale_fill_manual(values = c("Homem" = summer_brasil_2016_palette$primary[2],
"Mulher" = summer_brasil_2016_palette$primary[3]),
labels = c("Homens", "Mulheres")) +
# Tema, Títulos e Legendas
labs(
title = "EVOLUÇÃO DA PARTICIPAÇÃO POR GÊNERO DO BRASIL",
subtitle = "Olimpíadas de Inverno | 1992 Albertvill – 2022 Beijing",
x = "EDIÇÃO",
y = "TOTAL DE ATLETAS",
fill = "GÊNERO"
) +
theme_olympics() +
theme(panel.grid.major.x = element_line(color = "gray85"))
Podemos ver que o percentual de mulheres participando dos jogos olímpicos era muito discreto, com um crescimento acelerado que tem início após a primeira metade do século XX, chegando em níveis comparáveis com a parcela masculina apenas nas última edições dos jogos.
Agora vamos ver os resultados de medalhas gerais por país:
dados_paises <- game_medal_tally |>
mutate(estacao = case_when(str_detect(edition, "Verão") ~ "Verão",
str_detect(edition, "Inverno") ~ "Inverno"))
# Quadro Medalhas Países
tabela_medalhas <- dados_paises |>
group_by(country_noc) |>
# Tabela com o número de medalhas por país
summarise(
ouro = sum(gold, na.rm = TRUE),
prata = sum(silver, na.rm = TRUE),
bronze = sum(bronze, na.rm = TRUE),
.groups = "drop") |>
mutate(total_geral = ouro + prata + bronze) |>
# Ordena por ouro, prata e bronze
arrange(desc(ouro), desc(prata), desc(bronze)) |>
# Seleciona os 10 maiores e traduz
slice(1:10) |>
mutate(pais = case_match(country_noc,
"USA" ~ "Estados Unidos",
"URS" ~ "União Soviética",
"GER" ~ "Alemanha",
"GBR" ~ "Grã-Bretanha",
"FRA" ~ "França",
"ITA" ~ "Itália",
"CHN" ~ "China",
"SWE" ~ "Suécia",
"NOR" ~ "Noruega",
"RUS" ~ "Rússia")) |>
select(pais, ouro, prata, bronze, total_geral)
# Elaboração da tabela
tabela_medalhas |>
gt() |>
# Cabeçalho e Títulos
tab_header(
title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
subtitle = md("Países com Melhor Desempenho nos Jogos na História<br>(1896 Atenas – 2022 Beijing)")) |>
tab_style(
style = cell_text(style = "italic"),
locations = cells_title(groups = "subtitle")) |>
cols_label(
pais = "País",
ouro = "Ouro",
prata = "Prata",
bronze = "Bronze",
total_geral = "Total") |>
# Cores (Degradê de Medalhas)
data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
# Estilização de Texto
tab_style(
style = cell_text(color = "black"),
locations = cells_body(columns = everything())) |>
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = pais)) |>
# Formatação Numérica e Alinhamento
fmt_number(
columns = c(ouro, prata, bronze, total_geral),
decimals = 0,
use_seps = TRUE,
sep_mark = ".",
dec_mark = ",") |>
cols_align(align = "left", columns = pais) |>
cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
# Layout
tab_options(
heading.title.font.size = 24,
column_labels.font.weight = "bold",
table.width = pct(80))
| QUADRO HISTÓRICO DE MEDALHAS | ||||
| Países com Melhor Desempenho nos Jogos na História (1896 Atenas – 2022 Beijing) |
||||
| País | Ouro | Prata | Bronze | Total |
|---|---|---|---|---|
| Estados Unidos | 1.183 | 963 | 839 | 2.985 |
| União Soviética | 473 | 376 | 355 | 1.204 |
| Alemanha | 351 | 371 | 361 | 1.083 |
| Grã-Bretanha | 304 | 328 | 332 | 964 |
| China | 285 | 231 | 197 | 713 |
| França | 272 | 299 | 340 | 911 |
| Itália | 264 | 238 | 271 | 773 |
| Suécia | 214 | 228 | 241 | 683 |
| Noruega | 207 | 187 | 173 | 567 |
| Rússia | 194 | 169 | 188 | 551 |
# Quadro Medalhas Edição de Verão
tabela_medalhas <- dados_paises |>
filter(estacao == "Verão") |>
group_by(country_noc) |>
summarise(
ouro = sum(gold, na.rm = TRUE),
prata = sum(silver, na.rm = TRUE),
bronze = sum(bronze, na.rm = TRUE),
.groups = "drop") |>
mutate(total_geral = ouro + prata + bronze) |>
# Ordena por ouro, prata e bronze
arrange(desc(ouro), desc(prata), desc(bronze)) |>
# Seleciona os 10 maiores e traduz
slice(1:10) |>
mutate(pais = case_match(country_noc,
"USA" ~ "Estados Unidos",
"URS" ~ "União Soviética",
"GBR" ~ "Grã-Bretanha",
"CHN" ~ "China",
"GER" ~ "Alemanha",
"FRA" ~ "França",
"ITA" ~ "Itália",
"HUN" ~ "Hungria",
"JPN" ~ "Japão",
"AUS" ~ "Austrália")) |>
select(pais, ouro, prata, bronze, total_geral)
# Elaboração da tabela
tabela_medalhas |>
gt() |>
# Cabeçalho e Títulos
tab_header(
title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
subtitle = md("Países com Melhor Desempenho nos Jogos na História<br>(Olimpíadas de Verão | 1896 Atenas – 2020 Tokyo)")) |>
tab_style(
style = cell_text(style = "italic"),
locations = cells_title(groups = "subtitle")) |>
cols_label(
pais = "País",
ouro = "Ouro",
prata = "Prata",
bronze = "Bronze",
total_geral = "Total") |>
# Cores (Degradê de Medalhas)
data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
# Estilização de Texto
tab_style(
style = cell_text(color = "black"),
locations = cells_body(columns = everything())) |>
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = pais)) |>
# Formatação Numérica e Alinhamento
fmt_number(
columns = c(ouro, prata, bronze, total_geral),
decimals = 0,
use_seps = TRUE,
sep_mark = ".",
dec_mark = ",") |>
cols_align(align = "left", columns = pais) |>
cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
# Layout
tab_options(
heading.title.font.size = 24,
column_labels.font.weight = "bold",
table.width = pct(80))
| QUADRO HISTÓRICO DE MEDALHAS | ||||
| Países com Melhor Desempenho nos Jogos na História (Olimpíadas de Verão | 1896 Atenas – 2020 Tokyo) |
||||
| País | Ouro | Prata | Bronze | Total |
|---|---|---|---|---|
| Estados Unidos | 1.070 | 841 | 744 | 2.655 |
| União Soviética | 395 | 319 | 296 | 1.010 |
| Grã-Bretanha | 292 | 323 | 315 | 930 |
| China | 263 | 199 | 174 | 636 |
| Alemanha | 239 | 267 | 291 | 797 |
| França | 231 | 257 | 285 | 773 |
| Itália | 222 | 195 | 215 | 632 |
| Hungria | 182 | 156 | 177 | 515 |
| Japão | 169 | 150 | 180 | 499 |
| Austrália | 162 | 170 | 209 | 541 |
# Quadro Medalhas Edição de Inverno
tabela_medalhas <- dados_paises |>
filter(estacao == "Inverno") |>
group_by(country_noc) |>
summarise(
ouro = sum(gold, na.rm = TRUE),
prata = sum(silver, na.rm = TRUE),
bronze = sum(bronze, na.rm = TRUE),
.groups = "drop") |>
mutate(total_geral = ouro + prata + bronze) |>
# Ordena por ouro, prata e bronze
arrange(desc(ouro), desc(prata), desc(bronze)) |>
# Seleciona os 10 maiores e traduz
slice(1:10) |>
mutate(pais = case_match(country_noc,
"NOR" ~ "Noruega",
"USA" ~ "Estados Unidos",
"GER" ~ "Alemanha",
"URS" ~ "União Soviética",
"CAN" ~ "Canadá",
"AUT" ~ "Áustria",
"SWE" ~ "Suécia",
"SUI" ~ "Suíça",
"NED" ~ "Holanda",
"RUS" ~ "Rússia")) |>
select(pais, ouro, prata, bronze, total_geral)
# Elaboração da tabela
tabela_medalhas |>
gt() |>
# Cabeçalho e Títulos
tab_header(
title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
subtitle = md("Países com Melhor Desempenho nos Jogos na História<br>(Olimpíadas de Inverno | 1924 Chamonix – 2022 Beijing)")) |>
tab_style(
style = cell_text(style = "italic"),
locations = cells_title(groups = "subtitle")) |>
cols_label(
pais = "País",
ouro = "Ouro",
prata = "Prata",
bronze = "Bronze",
total_geral = "Total") |>
# Cores (Degradê de Medalhas)
data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
# Estilização de Texto
tab_style(
style = cell_text(color = "black"),
locations = cells_body(columns = everything())) |>
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = pais)) |>
# Formatação Numérica e Alinhamento
fmt_number(
columns = c(ouro, prata, bronze, total_geral),
decimals = 0,
use_seps = TRUE,
sep_mark = ".",
dec_mark = ",") |>
cols_align(align = "left", columns = pais) |>
cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
# Layout
tab_options(
heading.title.font.size = 24,
column_labels.font.weight = "bold",
table.width = pct(80))
| QUADRO HISTÓRICO DE MEDALHAS | ||||
| Países com Melhor Desempenho nos Jogos na História (Olimpíadas de Inverno | 1924 Chamonix – 2022 Beijing) |
||||
| País | Ouro | Prata | Bronze | Total |
|---|---|---|---|---|
| Noruega | 148 | 134 | 123 | 405 |
| Estados Unidos | 113 | 122 | 95 | 330 |
| Alemanha | 112 | 104 | 70 | 286 |
| União Soviética | 78 | 57 | 59 | 194 |
| Canadá | 77 | 72 | 76 | 225 |
| Áustria | 71 | 88 | 91 | 250 |
| Suécia | 65 | 51 | 60 | 176 |
| Suíça | 63 | 47 | 58 | 168 |
| Holanda | 53 | 49 | 45 | 147 |
| Rússia | 46 | 39 | 35 | 120 |
Aqui observamos que os Estados Unidos e a União Soviética (extinta) se consolidam como os maiores campeões olímpico até o momento. Entretanto, quando levamos em conta apenas as medalhas dos jogos de inverno, a Noruega consegue ultrapassar ambos e se destaca como uma potência nos esportes com neve.
Vamos analisar as premiações dos atletas:
# Quadro Medalhas Atletas
tabela_atletas <- dados_participacoes |>
group_by(atleta_id, nome) |>
summarise(
ouro = sum(medalha == "Ouro", na.rm = TRUE),
prata = sum(medalha == "Prata", na.rm = TRUE),
bronze = sum(medalha == "Bronze", na.rm = TRUE),
.groups = "drop") |>
mutate(total_geral = ouro + prata + bronze) |>
arrange(desc(ouro), desc(prata), desc(bronze)) |>
slice(1:10) |>
select(nome, ouro, prata, bronze, total_geral)
# Elaboração da tabela
tabela_atletas |>
gt() |>
# Cabeçalho e Títulos
tab_header(
title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
subtitle = md("Atletas com Melhor Desempenho nos Jogos na História<br>(1896 Atenas – 2022 Beijing)")) |>
tab_style(
style = cell_text(style = "italic"),
locations = cells_title(groups = "subtitle")) |>
cols_label(
nome = "Atleta",
ouro = "Ouro",
prata = "Prata",
bronze = "Bronze",
total_geral = "Total") |>
# Cores (Degradê de Medalhas)
data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
# Estilização de Texto
tab_style(
style = cell_text(color = "black"),
locations = cells_body(columns = everything())) |>
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = nome)) |>
# Formatação Numérica e Alinhamento
fmt_number(
columns = c(ouro, prata, bronze, total_geral),
decimals = 0,
use_seps = TRUE,
sep_mark = ".",
dec_mark = ",") |>
cols_align(align = "left", columns = nome) |>
cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
# Layout
tab_options(
heading.title.font.size = 24,
column_labels.font.weight = "bold",
table.width = pct(80))
| QUADRO HISTÓRICO DE MEDALHAS | ||||
| Atletas com Melhor Desempenho nos Jogos na História (1896 Atenas – 2022 Beijing) |
||||
| Atleta | Ouro | Prata | Bronze | Total |
|---|---|---|---|---|
| Michael Phelps | 23 | 3 | 2 | 28 |
| Larisa Latynina | 9 | 5 | 4 | 18 |
| Paavo Nurmi | 9 | 3 | 0 | 12 |
| Mark Spitz | 9 | 1 | 1 | 11 |
| Carl Lewis | 9 | 1 | 0 | 10 |
| Marit Bjørgen | 8 | 4 | 3 | 15 |
| Ole Einar Bjørndalen | 8 | 4 | 1 | 13 |
| Birgit Fischer-Schmidt | 8 | 4 | 0 | 12 |
| Bjørn Dæhlie | 8 | 4 | 0 | 12 |
| Sawao Kato | 8 | 3 | 1 | 12 |
# Quadro Medalhas Atletas Brasil
tabela_atletas <- dados_participacoes |>
filter(pais_sg == "BRA") |>
group_by(atleta_id, nome) |>
summarise(
ouro = sum(medalha == "Ouro", na.rm = TRUE),
prata = sum(medalha == "Prata", na.rm = TRUE),
bronze = sum(medalha == "Bronze", na.rm = TRUE),
.groups = "drop") |>
mutate(total_geral = ouro + prata + bronze) |>
arrange(desc(ouro), desc(prata), desc(bronze)) |>
slice(1:10) |>
select(nome, ouro, prata, bronze, total_geral)
# Elaboração da tabela
tabela_atletas |>
gt() |>
# Cabeçalho e Títulos
tab_header(
title = md("**QUADRO HISTÓRICO DE MEDALHAS**"),
subtitle = md("Atletas Brasileiros com Melhor Desempenho nos Jogos na História<br>(1920 Antuérpia – 2022 Beijing)")) |>
tab_style(
style = cell_text(style = "italic"),
locations = cells_title(groups = "subtitle")) |>
cols_label(
nome = "Atleta",
ouro = "Ouro",
prata = "Prata",
bronze = "Bronze",
total_geral = "Total") |>
# Cores (Degradê de Medalhas)
data_color(columns = ouro, palette = c("#FFD70030", "#FFD700")) |>
data_color(columns = prata, palette = c("#C0C0C030", "#C0C0C0")) |>
data_color(columns = bronze, palette = c("#CD7F3230", "#CD7F32")) |>
# Estilização de Texto
tab_style(
style = cell_text(color = "black"),
locations = cells_body(columns = everything())) |>
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = nome)) |>
# Formatação Numérica e Alinhamento
fmt_number(
columns = c(ouro, prata, bronze, total_geral),
decimals = 0,
use_seps = TRUE,
sep_mark = ".",
dec_mark = ",") |>
cols_align(align = "left", columns = nome) |>
cols_align(align = "center", columns = c(ouro, prata, bronze, total_geral)) |>
# Layout
tab_options(
heading.title.font.size = 24,
column_labels.font.weight = "bold",
table.width = pct(80))
| QUADRO HISTÓRICO DE MEDALHAS | ||||
| Atletas Brasileiros com Melhor Desempenho nos Jogos na História (1920 Antuérpia – 2022 Beijing) |
||||
| Atleta | Ouro | Prata | Bronze | Total |
|---|---|---|---|---|
| Robert Scheidt | 2 | 2 | 1 | 5 |
| Serginho | 2 | 2 | 0 | 4 |
| Torben Grael | 2 | 1 | 2 | 5 |
| Marcelo Ferreira | 2 | 0 | 1 | 3 |
| Giovane | 2 | 0 | 0 | 2 |
| Maurício | 2 | 0 | 0 | 2 |
| Adhemar da Silva | 2 | 0 | 0 | 2 |
| Fabiana | 2 | 0 | 0 | 2 |
| Paula | 2 | 0 | 0 | 2 |
| Thaísa | 2 | 0 | 0 | 2 |
Podemos aplicar outra visualização:
# Medalhas Atletas
quadro_atletas <- dados_participacoes |>
filter(!is.na(medalha)) |>
# Conta a combinação de atleta e medalha
count(nome, medalha) |>
# Transforma o tipo de medalha em colunas
pivot_wider(
names_from = medalha,
values_from = n,
values_fill = 0
) |>
mutate(across(any_of(c("Ouro", "Prata", "Bronze")), ~ .)) |>
# Cria o total e ordena
mutate(total = Ouro + Prata + Bronze) |>
arrange(desc(Ouro), desc(Prata), desc(Bronze)) |>
slice(1:10) |>
mutate(nome = fct_reorder(nome, Ouro + Prata/1000 + Bronze/1000000))
# Plotagem
ggplot(quadro_atletas) +
geom_segment(aes(x = pmin(Ouro, Prata, Bronze),
xend = pmax(Ouro, Prata, Bronze),
y = nome, yend = nome), color = "grey") +
# Ouros
geom_point(aes(x = Bronze, y= nome, color = "Bronze"), size = 8) +
# Pratas
geom_point(aes(x = Prata, y= nome, color = "Prata"), size = 6) +
# Bronzes
geom_point(aes(x = Ouro, y= nome, color = "Ouro"), size = 4) +
# Tema, Legendas e Títulos
scale_color_manual(
name = "TIPO DE MEDALHA",
values = c("Ouro" = "#FFD700", "Prata" = "#C0C0C0", "Bronze" = "#CD7F32"),
breaks = c("Ouro", "Prata", "Bronze")) +
labs(
title = "QUADRO HISTÓRICO DE MEDALHAS",
subtitle = "Atletas com Melhor Desempenho nos Jogos na História\n(1896 Atenas – 2022 Beijing)",
x = "MEDALHAS",
y = NULL) +
theme_olympics() +
theme(panel.grid.major.y = element_blank())
# Medalhas Atletas Brasil
quadro_atletas <- dados_participacoes |>
filter(!is.na(medalha), pais_sg == "BRA") |>
# Conta a combinação de atleta e medalha
count(nome, medalha) |>
# Transforma o tipo de medalha em colunas
pivot_wider(
names_from = medalha,
values_from = n,
values_fill = 0
) |>
mutate(across(any_of(c("Ouro", "Prata", "Bronze")), ~ .)) |>
# Cria o total e ordena
mutate(total = Ouro + Prata + Bronze) |>
arrange(desc(Ouro), desc(Prata), desc(Bronze)) |>
slice(1:10) |>
mutate(nome = fct_reorder(nome, Ouro + Prata/1000 + Bronze/1000000))
# Plotagem
ggplot(quadro_atletas) +
geom_segment(aes(x = pmin(Ouro, Prata, Bronze),
xend = pmax(Ouro, Prata, Bronze),
y = nome, yend = nome), color = "grey") +
# Ouros
geom_point(aes(x = Bronze, y= nome, color = "Bronze"), size = 8) +
# Pratas
geom_point(aes(x = Prata, y= nome, color = "Prata"), size = 6) +
# Bronzes
geom_point(aes(x = Ouro, y= nome, color = "Ouro"), size = 4) +
# Tema, Legendas e Títulos
scale_x_continuous(breaks = seq(0, 2, by =1)) +
scale_color_manual(
name = "TIPO DE MEDALHA",
values = c("Ouro" = "#FFD700", "Prata" = "#C0C0C0", "Bronze" = "#CD7F32"),
breaks = c("Ouro", "Prata", "Bronze")) +
labs(
title = "QUADRO HISTÓRICO DE MEDALHAS",
subtitle = "Atletas Brasileiros com Melhor Desempenho nos Jogos na História\n(1920 Antuérpia – 2022 Beijing)",
x = "MEDALHAS",
y = NULL) +
theme_olympics() +
theme(panel.grid.major.y = element_blank())
O nadador Michall Phelps quando comparado com os demais atletas apresenta uma quantidade de medalhas de ouro desproporcionalmente superior ao demais, enquanto isso, os atletas brasileiros aparentam um desempenho relativamente similar aos outros.
Agora vamos utilizar algumas informações geográficas. Para isso vamos precisar de algumas geoometrias espaciais.
# Preparação
cidades_sedes <- dados_latlong |>
filter(estacao == "Verão") |>
count(cidade, longitude, latitude, name = "ocorrencia")
cidades_sf_verao <- st_as_sf(cidades_sedes,
coords = c("longitude", "latitude"),
crs = 4326)
cidades_sedes <- dados_latlong |>
filter(estacao == "Inverno") |>
count(cidade, longitude, latitude, name = "ocorrencia")
cidades_sf_inverno <- st_as_sf(cidades_sedes,
coords = c("longitude", "latitude"),
crs = 4326)
# Mapa Mundi (Robinson)
mundo_sf <- ne_countries(scale = "large", returnclass = "sf") |>
filter(continent != "Antarctica")
Agora vamos analisar a distribuição das sedes olímpicas utilizando a ferramenta dos mapas.
# Plotagem
ggplot() +
# Mapa
geom_sf(data = mundo_sf, fill = "#F2F2F2", color = "#D1D1D1", size = 0.1) +
# Cidades
geom_sf(data = cidades_sf_verao,
aes(size = ocorrencia),
color = winter_swiss_1928_palette$primary[1],
alpha = 0.6,
shape = 16) +
# Adicionando um contorno sutil nos pontos para dar profundidade
geom_sf(data = cidades_sf_verao,
aes(size = ocorrencia),
color = winter_swiss_1928_palette$primary[1],
shape = 21,
stroke = 0.5,
fill = NA) +
# Projeção Robinson
coord_sf(crs = "+proj=robin") +
# Escala de tamanhos
scale_size_area(max_size = 6, breaks = c(1, 2, 3)) +
# Títulos e Temas
labs(
title = "CIDADES QUE SEDIARAM OS JOGOS",
subtitle = "Distribuição das Sedes das Olimpíadas de Verão (1896 Atenas – 2020 Tokyo)",
size = "OCORRÊNCIAS") +
theme_olympics() +
theme(axis.text.x = element_blank(),
axis.text.y = element_blank())
# Plotagem
ggplot() +
# Mapa
geom_sf(data = mundo_sf, fill = "#F2F2F2", color = "#D1D1D1", size = 0.1) +
# Cidades
geom_sf(data = cidades_sf_inverno,
aes(size = ocorrencia),
color = winter_swiss_1928_palette$primary[3],
alpha = 0.6,
shape = 16) +
# Adicionando um contorno sutil nos pontos para dar profundidade
geom_sf(data = cidades_sf_inverno,
aes(size = ocorrencia),
color = winter_swiss_1928_palette$primary[3],
shape = 21,
stroke = 0.5,
fill = NA) +
# Projeção Robinson
coord_sf(crs = "+proj=robin") +
# Escala de tamanhos
scale_size_area(max_size = 4, breaks = c(1, 2)) +
# Títulos e Temas
labs(
title = "CIDADES QUE SEDIARAM OS JOGOS",
subtitle = "Distribuição das Sedes das Olimpíadas de Inverno (1896 Atenas – 2022 Beijing)",
size = "OCORRÊNCIAS") +
theme_olympics() +
theme(axis.text.x = element_blank(),
axis.text.y = element_blank())
Os mapas nos mostram que a distribuição dos países que realizam os jogos olímpicos é bastante heterogênea. Existe uma concentração na Europa e na América Anglo-Saxônica, com poucos casos na Ásia, Oceania e na América Latina (Nenhuma ocorrência no continente africano).
Por conta da grande densidade de pontos no continente europeu, vamos observar mais de perto esses casos.
# Plotagem com Zoom na Europa
ggplot() +
# Mapa
geom_sf(data = mundo_sf, fill = "#F2F2F2", color = "#D1D1D1", size = 0.1) +
# Cidades
geom_sf(data = cidades_sf_verao,
aes(size = ocorrencia),
color = winter_swiss_1928_palette$primary[1],
alpha = 0.6,
shape = 16) +
# Contorno sutil
geom_sf(data = cidades_sf_verao,
aes(size = ocorrencia),
color = winter_swiss_1928_palette$primary[1],
shape = 21,
stroke = 0.5,
fill = NA) +
# Usamos crs = 4326 para que os limites x e y funcionem como esperado
coord_sf(xlim = c(-15, 42), ylim = c(33, 68), expand = FALSE) +
scale_size_area(max_size = 8, breaks = c(1, 2, 3)) +
labs(
title = "FOCO: SEDES EUROPEIAS",
subtitle = "Olimpíadas de Verão na Europa (1896 Atenas – 2012 Londres)",
size = "OCORRÊNCIAS") +
theme_olympics() +
theme(axis.text.x = element_blank(),
axis.text.y = element_blank())
# Plotagem com Zoom na Europa
ggplot() +
# Mapa
geom_sf(data = mundo_sf, fill = "#F2F2F2", color = "#D1D1D1", size = 0.1) +
# Cidades
geom_sf(data = cidades_sf_inverno,
aes(size = ocorrencia),
color = winter_swiss_1928_palette$primary[3],
alpha = 0.6,
shape = 16) +
# Contorno sutil
geom_sf(data = cidades_sf_inverno,
aes(size = ocorrencia),
color = winter_swiss_1928_palette$primary[3],
shape = 21,
stroke = 0.5,
fill = NA) +
# Usamos crs = 4326 para que os limites x e y funcionem como esperado
coord_sf(xlim = c(-15, 42), ylim = c(33, 68), expand = FALSE) +
scale_size_area(max_size = 8, breaks = c(1, 2, 3)) +
labs(
title = "FOCO: SEDES EUROPEIAS",
subtitle = "Olimpíadas de Inverno na Europa (1924 Chamonix – 2014 Sóchi)",
size = "OCORRÊNCIAS") +
theme_olympics() +
theme(axis.text.x = element_blank(),
axis.text.y = element_blank())
Para investigar a existência de um possível efeito sede, construímos duas métricas de desempenho comparáveis entre países e edições:
A primeira métrica permite capturar não apenas a quantidade, mas também a qualidade das medalhas obtidas. Já o índice de medalhas controla o tamanho da edição, tornando comparáveis Jogos com diferentes números de provas e participantes.
Para calcular essas medidas, construímos uma base por país e edição. Além do cálculo das métricas, identificamos se o país atuava como sede naquela edição, contabilizamos o número de atletas enviados por delegação e atribuímos o continente correspondente a cada país. Também excluímos equipes mistas e atletas independentes, pois não podem ser associados a um país específico, o que comprometeria a análise do efeito sede.
athlete_count <- athlete_event_result |>
select(
edition_id,
country_noc,
athlete_id
) |>
group_by(edition_id, country_noc) |>
summarise(
n_athletes = n_distinct(athlete_id),
.groups = "drop"
)
medals_per_country_per_edition <- game_medal_tally |>
left_join(
game |> select(edition_id, host_country),
by = "edition_id"
) |>
mutate(
is_host = country_noc == host_country,
score_total = (4 * gold) + (2 * silver) + bronze,
) |>
group_by(country_noc, edition_id, year, edition) |>
summarise(
gold = sum(gold, na.rm = TRUE),
silver = sum(silver, na.rm = TRUE),
bronze = sum(bronze, na.rm = TRUE),
total = sum(total, na.rm = TRUE),
is_host = any(is_host),
score_total = sum(score_total, na.rm = TRUE),
.groups = "drop"
) |>
mutate(
continent = countrycode(country_noc, "ioc", "continent"),
# Países que deixaram de existir ou outros grupos
continent = case_when(
country_noc == "AHO" ~ "Americas", # Netherlands Antilles
country_noc == "ANZ" ~ "Oceania", # Australasia
country_noc == "BOH" ~ "Europe", # Bohemia
country_noc == "EUN" ~ "Europe", # Equipe Unificada
country_noc == "FRG" ~ "Europe", # Alemanha Ocidental
country_noc == "GDR" ~ "Europe", # Alemanha Oriental
country_noc == "IOA" ~ NA_character_,# Atletas Independentes
country_noc == "KOS" ~ "Europe", # Kosovo
country_noc == "MIX" ~ NA_character_,# Mixed Team
country_noc == "ROC" & year < 2020 ~ "Asia", # Taiwan/China
country_noc == "ROC" & year >= 2020 ~ "Europe", # Comitê Olímpico Russo
country_noc == "SCG" ~ "Europe", # Sérvia e Montenegro
country_noc == "TCH" ~ "Europe", # Tchecoslováquia
country_noc == "UAR" ~ "Africa", # República Árabe Unida (Egito)
country_noc == "URS" ~ "Europe", # União Soviética
country_noc == "WIF" ~ "Americas", # West Indies Federation (Caribe)
country_noc == "YUG" ~ "Europe", # Iugoslávia
TRUE ~ continent
)
) |>
group_by(edition_id) |>
mutate(
medal_rate = total / sum(total)
) |>
ungroup() |>
filter(!is.na(continent)) |>
left_join(athlete_count, by = c("edition_id", "country_noc"))
Além da análise por edição, é interessante observar o desempenho dos países de forma acumulada ao longo do tempo. O score acumulado permite visualizar a consolidação histórica das potências olímpicas, mostrando quais países mantêm um desempenho consistente ao longo das décadas. Para construir essa métrica, ordenamos os dados por país e ano e aplicamos a soma acumulada do score total obtido em cada edição.
score_cum <- medals_per_country_per_edition |>
arrange(country_noc, edition_id) |>
group_by(country_noc, edition) |>
mutate(
score_cum = cumsum(score_total)
) |>
ungroup() |>
select(
country_noc,
continent,
year,
edition,
is_host,
score = score_cum
) |>
mutate(
edition = factor(
edition,
levels = c("Olimpíadas de Verão",
"Olimpíadas de Inverno")
)
)
Dessa forma, cada ponto no gráfico representa o total de pontos já conquistados pelo país até aquele ano.
# Labels que aparecerão no gráfico
huge_score <- score_cum |>
group_by(country_noc, edition) |>
filter((edition == "Olimpíadas de Verão" & score >= 2000) | (edition == "Olimpíadas de Inverno" & score >= 450)) |>
slice_max(year, n = 1)
ggplot(
score_cum,
aes(x = year, y = score, color = continent, group = country_noc)
) +
geom_line(size = 0.8, alpha = 0.6) +
scale_color_manual(
name = "Continente",
values = c(
"Africa" = "#F26E22",
"Americas" = "#7ABF49",
"Asia" = "#F2B90C",
"Europe" = "#03588C",
"Oceania" = "#A60D0D"
),
labels = c(
"Africa" = "África",
"Americas" = "América",
"Asia" = "Ásia",
"Europe" = "Europa",
"Oceania" = "Oceania"
)
) +
geom_point(
data = huge_score,
size = 2,
color = "black",
show.legend = FALSE
) +
geom_text_repel(
data = bind_rows(huge_score),
aes(label = country_noc),
size = 3,
color = "black",
show.legend = FALSE
) +
facet_wrap(~ edition, ncol = 2, scales = "free") +
labs(
title = "Evolução do score acumulado por país",
x = NULL,
y = "Score acumulado",
caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
) +
theme_olympics()
Como o número de países é elevado, a parte inferior do gráfico se torna visualmente poluída. Por isso, em seguida apresentamos uma versão focada nos três países com maior score atual em cada continente.
# Busca os 3 países com o maior score atual por continente
top_countries <- score_cum |>
group_by(edition, continent, country_noc) |>
slice_max(year, n = 1) |>
ungroup() |>
group_by(edition, continent) |>
slice_max(score, n = 3) |>
ungroup() |>
select(edition, continent, country_noc)
# Pega as informações dos melhores países
top_by_continent <- score_cum |>
semi_join(
top_countries,
by = c("edition", "continent", "country_noc")
)
# Labels que aparecerão no gráfico
labels_data <- top_by_continent |>
group_by(edition, country_noc) |>
arrange(year, .by_group = TRUE) |>
mutate(
group_id = cur_group_id(),
n = n(),
label_position = round(n * (0.1 + 0.2 * (group_id %% 3))),
continent = continent
) |>
filter(row_number() == label_position) |>
ungroup()
ggplot(
top_by_continent,
aes(x = year, y = score, color = continent, group = country_noc)
) +
geom_line(size = 0.8, alpha = 0.6) +
scale_color_manual(
name = "Continente",
values = c(
"Africa" = "#F26E22",
"Americas" = "#7ABF49",
"Asia" = "#F2B90C",
"Europe" = "#03588C",
"Oceania" = "#A60D0D"
),
labels = c(
"Africa" = "África",
"Americas" = "América",
"Asia" = "Ásia",
"Europe" = "Europa",
"Oceania" = "Oceania"
)
) +
geom_text_repel(
data = labels_data,
aes(label = country_noc, color = continent),
size = 3,
fontface = "bold",
show.legend = FALSE
) +
facet_wrap(~ edition, ncol = 2, scales = "free") +
labs(
title = "Evolução do score acumulado por país",
subtitle = "Top 3 atuais por continente",
x = NULL,
y = "Score acumulado",
caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
) +
theme_olympics()
No caso da América, observa-se que o Brasil não está entre os três países com os maiores scores atuais. Isso motiva uma análise específica da evolução brasileira dentro do continente, destacando sua trajetória histórica e comparando-a com outras nações americanas.
# Labels que aparecerão no gráfico
labels_data <- score_cum |>
filter(continent == "Americas") |>
group_by(edition, country_noc) |>
arrange(year, .by_group = TRUE) |>
mutate(
group_id = cur_group_id(),
n = n(),
label_position = round(n * (0.1 + 0.3 * (group_id %% 3)))
) |>
filter(row_number() == label_position) |>
ungroup()
ggplot(
score_cum |> filter(continent == "Americas"),
aes(
x = year,
y = score,
color = country_noc,
)
) +
geom_line(size = 0.8, show.legend = FALSE) +
geom_text_repel(
data = labels_data,
aes(label = country_noc),
size = 3,
fontface = "bold",
show.legend = FALSE
) +
scale_color_manual(
values = c(
winter_italy_1956_palette$primary,
summer_brasil_2016_palette$primary,
summer_canada_1976_palette$primary,
winter_germany_1936_palette$primary,
summer_usa_1932_palette$primary,
winter_swiss_1928_palette$primary
)
) +
facet_wrap(~ edition, ncol = 2, scales = "free") +
labs(
title = "Evolução do score acumulado por país",
subtitle = "América",
x = NULL,
y = "Score acumulado",
caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
) +
theme_olympics()
Apesar do recorte continental reduzir a complexidade da visualização, ainda há muitas curvas sobrepostas, o que dificulta a leitura da trajetória específica do Brasil. Ao destacar o Brasil, conseguimos observar melhor seu ritmo de crescimento e sua posição relativa dentro do continente.
ggplot(
score_cum |> filter(continent == "Americas"),
aes(
x = year,
y = score,
color = country_noc,
alpha = country_noc == "BRA" | edition == "Olimpíadas de Inverno")
) +
scale_alpha_manual(
values = c(
"TRUE" = 1,
"FALSE" = 0.3
),
guide = "none"
) +
geom_line(size = 0.8, show.legend = FALSE) +
geom_text_repel(
data = labels_data,
aes(label = country_noc, color = country_noc),
size = 3,
fontface = "bold",
show.legend = FALSE
) +
scale_color_manual(
values = c(
winter_italy_1956_palette$primary,
summer_brasil_2016_palette$primary,
summer_canada_1976_palette$primary,
winter_germany_1936_palette$primary,
summer_usa_1932_palette$primary,
winter_swiss_1928_palette$primary
)
) +
facet_wrap(~ edition, ncol = 2, scales = "free") +
labs(
title = "Evolução do score acumulado por país",
subtitle = "América - Brasil em destaque",
x = NULL,
y = "Score acumulado",
caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
) +
theme_olympics()
Para comparar as métricas, utilizaremos os mesmos gráficos feitos com as duas métricas. Para atingir nosso propósito, precisamos de alguns dados gerais sobre o desempenho brasileiro.
mean_brasil <- medals_per_country_per_edition |>
filter(country_noc == "BRA") |>
group_by(edition, is_host) |>
summarise(
mean_score = mean(score_total),
mean_medal_rate = mean(medal_rate),
.groups = "drop"
) |>
mutate(
is_host = factor(
is_host,
levels = c(TRUE, FALSE),
labels = c("Sede", "Não sede")
)
)
O primeiro gráfico que plotaremos é um boxplot do desempenho por país em cada métrica com destaque para o Brasil.
# Score
score_by_country <- medals_per_country_per_edition |>
mutate(
is_host = factor(
is_host,
levels = c(TRUE, FALSE),
labels = c("Sede", "Não sede")
)
) |>
ggplot(aes(x = is_host, y = score_total, fill = is_host)) +
geom_boxplot(alpha = 0.8, width = 0.6, show.legend = FALSE) +
geom_point(
data = mean_brasil,
aes(x = is_host, y = mean_score),
shape = 23,
size = 2,
stroke = 0.8,
color = "black",
fill = "yellow"
) +
facet_wrap(~ edition, scales = "free") +
scale_fill_manual(values = summer_brasil_2016_palette$primary) +
labs(
x = NULL,
y = "Score"
) +
theme_olympics()
# Índice de medalhas
medal_rate_by_country <- medals_per_country_per_edition |>
mutate(
is_host = factor(
is_host,
levels = c(TRUE, FALSE),
labels = c("Sede", "Não sede")
)
) |>
ggplot(aes(x = is_host, y = medal_rate, fill = is_host)) +
geom_boxplot(alpha = 0.8, width = 0.6, show.legend = FALSE) +
geom_point(
data = mean_brasil,
aes(x = is_host, y = mean_medal_rate),
shape = 23,
size = 2,
stroke = 0.8,
color = "black",
fill = "yellow"
) +
facet_wrap(~ edition, scales = "free") +
scale_fill_manual(values = summer_brasil_2016_palette$primary) +
labs(
x = NULL,
y = "Índice de Medalhas"
) +
theme_olympics()
(score_by_country + medal_rate_by_country) +
plot_layout(widths = c(1, 1)) +
plot_annotation(
title = "Métricas por país",
subtitle = "Brasil destacado",
caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
) &
theme(
plot.title = element_text(face = "bold", size = 18),
plot.subtitle = element_text(face = "italic", size = 13, margin = margin(b = 8)),
plot.caption = element_text(size = 11, color = "gray10")
)
Embora baseadas em aspectos distintos, as duas métricas apresentam padrões semelhantes entre si. O Score enfatiza a qualidade das medalhas conquistadas, ao atribuir pesos diferentes, enquanto o Índice de Medalhas captura a participação relativa do país no total de premiações. A semelhança dos resultados indica que sediar os Jogos tende a ampliar tanto o volume de medalhas quanto a relevância do desempenho. Assim, podemos analisar qual foi o impacto das olimpíadas de 2016 no desempenho brasileiro.
score_athletes <- medals_per_country_per_edition |>
filter(country_noc == "BRA") |>
mutate(
is_host = factor(
is_host,
levels = c(TRUE, FALSE),
labels = c("Sede", "Não sede")
)
) |>
ggplot(
aes(
x = year,
y = score_total,
color = is_host,
size = n_athletes
)
) +
geom_point(alpha = 0.6, stroke = 1.2) +
scale_color_manual(values = summer_brasil_2016_palette$primary, name = NULL) +
scale_size_continuous(range = c(2, 12)) +
labs(
x = NULL,
y = "Score"
) +
guides(size = "none") +
theme_olympics()
# Índice de Medalhas
medal_rate_athletes <- medals_per_country_per_edition |>
filter(country_noc == "BRA") |>
mutate(
is_host = factor(
is_host,
levels = c(TRUE, FALSE),
labels = c("Sede", "Não sede")
)
) |>
ggplot(
aes(
x = year,
y = medal_rate,
color = is_host,
size = n_athletes
)
) +
geom_point(alpha = 0.6, stroke = 1.2) +
scale_color_manual(values = summer_brasil_2016_palette$primary, name = NULL) +
scale_size_continuous(range = c(2, 12)) +
labs(
x = NULL,
y = "Índice de Medalhas"
) +
guides(size = "none") +
theme_olympics()
(score_athletes + medal_rate_athletes) +
plot_layout(widths = c(1, 1)) +
plot_annotation(
title = "Métricas brasileiras por edição nos jogos de verão",
subtitle = "Tamanho do ponto representa o número de atletas medalhistas",
caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
) &
theme(
plot.title = element_text(face = "bold", size = 18),
plot.subtitle = element_text(face = "italic", size = 13, margin = margin(b = 8)),
plot.caption = element_text(size = 11, color = "gray10")
)
A visualização temporal sugere que podem haver efeitos que se estendem além do ano em que o país foi sede dos jogos. Observa-se um aumento no número de atletas em 2016, o que é esperado, dado que o país sede possui vagas automáticas em diversas modalidades. Esse aumento pode explicar parte do crescimento no desempenho. Entretanto, como os resultados competitivos em 2020 se mantém perto dos resultados de 2016, o impacto pode não se restringir ao ano em que o país é sede. Tentando ver como esse efeito sede se comporta no geral, vamos calculá-lo para os outros países para compará-lo com o efeito sede brasileiro.
host_effect_score <- medals_per_country_per_edition |>
group_by(country_noc, edition, is_host) |>
summarise(
mean_score = mean(score_total),
.groups = "drop"
) |>
pivot_wider(
names_from = is_host,
values_from = mean_score
) |>
mutate(
host_effect = `TRUE` - `FALSE`,
is_brasil = country_noc == "BRA"
) |>
filter(!is.na(host_effect))
host_effect_medal_rate <- medals_per_country_per_edition |>
group_by(country_noc, edition, is_host) |>
summarise(
mean_medal_rate = mean(medal_rate),
.groups = "drop"
) |>
pivot_wider(
names_from = is_host,
values_from = mean_medal_rate
) |>
mutate(
host_effect = `TRUE` - `FALSE`,
is_brasil = country_noc == "BRA"
) |>
filter(!is.na(host_effect))
Assim, podemos plotar um boxplot para entender o efeito sede geral.
score_host_effect <- ggplot(host_effect_score, aes(x = edition, y = host_effect, fill = edition)) +
geom_boxplot(alpha = 0.8, width = 0.6, show.legend = FALSE) +
geom_point(
data = host_effect_score |> filter(country_noc == "BRA"),
aes(x = edition, y = host_effect),
shape = 23,
size = 2,
stroke = 0.8,
color = "black",
fill = "yellow"
) +
scale_fill_manual(values = winter_italy_1956_palette$secondary) +
labs(
x = NULL,
y = "Efeito Sede (Score)",
color = NULL
) +
theme_olympics()
medal_rate_host_effect <- ggplot(host_effect_medal_rate, aes(x = edition, y = host_effect, fill = edition)) +
geom_boxplot(alpha = 0.8, width = 0.6, show.legend = FALSE) +
geom_point(
data = host_effect_medal_rate |> filter(country_noc == "BRA"),
aes(x = edition, y = host_effect),
shape = 23,
size = 2,
stroke = 0.8,
color = "black",
fill = "yellow"
) +
scale_fill_manual(values = winter_italy_1956_palette$secondary) +
labs(
x = NULL,
y = "Efeito Sede (Índice de Medalhas)",
color = NULL
) +
theme_olympics()
(score_host_effect + medal_rate_host_effect) +
plot_layout(widths = c(1, 1)) +
plot_annotation(
title = "Distribuição do Efeito Sede por País",
subtitle = "Diferença média de pontuação - Brasil destacado",
caption = "Fonte: Base dos Dados - Historical Data from the Olympics"
) &
theme(
plot.title = element_text(face = "bold", size = 18),
plot.subtitle = element_text(face = "italic", size = 13, margin = margin(b = 8)),
plot.caption = element_text(size = 11, color = "gray10")
)
Os boxplots indicam que, em média, a distribuição do efeito sede é positiva, tanto quando medido pelo Score quanto pelo Índice de Medalhas. Isso sugere que, de maneira geral, os países tendem a apresentar desempenho superior quando competem em casa. A mediana acima de zero em ambas as métricas reforça a hipótese da existência de um efeito sede estrutural, e não apenas uma coincidência.
Inicialmente, podemos perceber ao longo da análise uma heterogeneidade na distribuição dos atletas, medalhas e sediamento do evento. Apesar de representar menos de 15% da população mundial, a Europa e a América do Norte compõem os principais quadros de medalhas. Isso indica que apesar de propor uma dinâmica internacional do esporte, os recursos necessários para a garantia de fornecer treinamento, suporte e envio de atletas ainda não são uma realidade palpável para a maioria das nações.
A partir das métricas construídas, identificou-se a existência de um efeito sede nos Jogos Olímpicos. Tanto o Score quanto o Índice de Medalhas indicam que, em média, os países tendem a apresentar desempenho superior quando competem como anfitriões, com medianas positivas em ambas as medidas. Apesar de capturarem dimensões distintas, as duas métricas apresentaram resultados convergentes. Isso sugere que sediar os Jogos pode ampliar não apenas o volume absoluto de medalhas, mas também a relevância proporcional do desempenho.
No caso brasileiro, observou-se melhora expressiva em 2016, acompanhada por aumento no número de atletas. Parte desse efeito pode ser explicada por fatores como maior delegação e apoio da torcida, mas os resultados em 2020 indicam que investimentos realizados no ciclo olímpico também podem ter contribuído. Entretanto, a dispersão observada no caso geral mostra que os ganhos variam significativamente, sugerindo que o impacto também depende de características estruturais, como tradição esportiva e capacidade de investimento. Além disso, países escolhidos para sediar os Jogos frequentemente já possuem forte histórico esportivo.
BASE DOS DADOS. Historical Data from the Olympics. Disponível em: https://basedosdados.org/dataset/62f8cb83-ac37-48be-874b-b94dd92d3e2b.
FLOURISH. How to visualize the Olympics. Disponível em: https://flourish.studio/blog/visualizing-olympics/.
FLOWINGDATA. History of Sumo Charted. Disponível em: https://flowingdata.com/2016/05/16/history-of-sumo-charted/.
OLYMPEDIA. Olympedia. Disponível em: https://www.olympedia.org/.
SCIELO. Visual abstracts. Disponível em: https://www.scielo.br/j/jbn/a/4kqVkwSqkgFTbdC9VgThvnP/?format=pdf&lang=pt.
THE OLYMPIC DESIGN. Olympic Games – The Design. Disponível em: https://www.theolympicdesign.com/.
# Paletas
winter_france_1924_palette <- list(
primary = c("#07598C", "#F2A413", "#A63B32", "#BF491F", "#F0EADC"),
secondary = c("#012340", "#025E73", "#D9A404", "#D97904", "#D9C5A0"),
tertiary = c("#3E4649", "#7897BF", "#A6294B", "#D9593D", "#F2EFDF"),
quaternary = c("#3285A6", "#4694A6", "#D97904", "#D96704", "#A60D0D")
)
winter_swiss_1928_palette <- list(
primary = c("#BF0B1A", "#EEC50B", "#065473", "#157A74", "#F1F3E5")
)
summer_usa_1932_palette <- list(
primary = c("#0E4459", "#1F6373", "#E09714", "#BF1717", "#F2E5D5")
)
winter_germany_1936_palette <- list(
primary = c("#040B11", "#2D2273", "#F2D544", "#D91111", "#F2E8DC")
)
winter_italy_1956_palette <- list(
primary = c("#001D2D", "#037F8C", "#F2C335", "#BF3C1F", "#D9C6B0"),
secondary = c("#0D0F1B", "#263F8C", "#F2CE1B", "#D92211", "#F2F0EB")
)
summer_canada_1976_palette <- list(
primary = c("#2C2C24", "#0367A6", "#0378A6", "#D91E0D", "#F2F2EB"),
secondary = c("#0477BF", "#1AA3D9", "#F2F2EB", "#F2CE16", "#F29F05")
)
summer_brasil_2016_palette <- list(
primary = c("#03588C", "#7ABF49", "#F2B90C", "#F26E22", "#F2F2F2")
)
theme_olympics <- function(pallete) {
theme_minimal(base_size = 12) +
theme(
plot.margin = margin(
t = 10,
r = 15,
b = 10,
l = 15
),
plot.title = element_text(face = "bold", size = 16),
plot.subtitle = element_text(face = "italic", size = 12, margin = margin(b = 8)),
plot.caption = element_text(size = 9, color = "gray10"),
strip.text = element_text(face = "bold", size = 11),
strip.background = element_rect(fill = "gray90", color = NA),
axis.title = element_text(face = "bold", size = 10),
axis.text.y = element_text(face = "italic"),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(color = "gray85")
)
}